election_data: archivo con las elecciones al congresocod_mun: archivo con los códigos y nombres de cada municipioabbrev: siglas de cada partidosurveys: encuestas electorales desde 1982.Nos ocupamos primero de las encuestas:
Eliminar columnas de surveys sin info + encuestas a pie de urna y anteriores a 2008. Será necesario hacer un pivot_table como en elecciones
Seguimos con los datos electorales
election_data <-
election_data |>
select(-c(tipo_eleccion,
codigo_distrito_electoral,
numero_mesas,
vuelta))
election_data <- election_data|>
mutate(id_municipio = glue("{codigo_ccaa}{codigo_provincia}{codigo_municipio}")) |>
relocate(id_municipio, .before=codigo_ccaa)
#Mantenemos part1 y part2 pq nos pueden resultar útiles para alguna pregunta más adelante
election_data <-
election_data |>
select(-c(codigo_ccaa,
codigo_provincia,
codigo_municipio,))
election_data <- election_data|>
mutate(fecha = glue("1-{mes}-{anno}")) |>
relocate(fecha, .before=anno)
#usamos lubridate
election_data<-election_data |> mutate(fecha=dmy(fecha)) |> select(-c(anno,mes))
#convertimos los datos a tidy
election_data <-
election_data |>
pivot_longer(cols = "BERDEAK-LOS VERDES":"COALICIÓN POR MELILLA", names_to = "partidos", values_to = "votos", values_drop_na = TRUE )Utilizamos la variable partidos para agrupar todos ellos en solo 12: “PP” “UP” “PSOE” “PNV” “Cs” “ERC” “CIU” “MP” “VOX” “BNG” “EH-BILDU” “OTROS”
# manera 1
resumen <-
election_data |>
mutate('siglas' = case_when(
str_detect(partidos, regex("EZKER BA|ENTESA|PODEM|COMPROMÍS|IZQUIERDA UNIDA|ESQUERRA UNI|ESQUERDA UNI|I\\.U\\.|IU ")) ~ "UP",
str_detect(partidos, "PP|PARTIDO POPULAR|PARTIT POPULAR") ~ "PP",
str_detect(partidos, "PNV|PARTIDO NACIONALISTA VASCO") ~ "PNV",
str_detect(partidos, "PSOE|PSC|PARTIDO SOCIALISTA|PARTIT SOCIALISTA|PARTIT DELS SOCIALISTES |PARTIDO DOS SOCIALISTA") ~ "PSOE",
str_detect(partidos, "MÁS PAÍS") ~ "MP",
str_detect(partidos, "VOX") ~ "VOX",
str_detect(partidos, "AMAIUR|ARALAR|EUSKO|EUSKAL HERRI|BILDU") ~ "EH-BILDU",
str_detect(partidos, "ERC|ESQUERRA REPUBLICANA DE C|ESQUERRA REPUBLICANA$|ESQUERRA REPUBLICANA/") ~ "ERC",
str_detect(partidos, "BNG|BLOQUE") ~ "BNG",
str_detect(partidos, "CIUTADANS|PARTIDO DE LA CIU") ~ "Cs",
str_detect(partidos, "CONVERGENCIA I| CONVERGENCIA i|CONVERGÈNCIA|UNIÓ D") ~ "CIU",
TRUE ~ "OTROS"
))
resumen# A tibble: 396,735 × 11
fecha id_municipio censo participacion_1 participacion_2 votos_blancos
<date> <glue> <dbl> <dbl> <dbl> <dbl>
1 2008-03-01 1401001 1838 677 1008 23
2 2008-03-01 1401001 1838 677 1008 23
3 2008-03-01 1401001 1838 677 1008 23
4 2008-03-01 1401001 1838 677 1008 23
5 2008-03-01 1401001 1838 677 1008 23
6 2008-03-01 1401001 1838 677 1008 23
7 2008-03-01 1401001 1838 677 1008 23
8 2008-03-01 1401001 1838 677 1008 23
9 2008-03-01 1401001 1838 677 1008 23
10 2008-03-01 1401001 1838 677 1008 23
# ℹ 396,725 more rows
# ℹ 5 more variables: votos_nulos <dbl>, votos_candidaturas <dbl>,
# partidos <chr>, votos <dbl>, siglas <chr>
[1] "OTROS" "EH-BILDU" "PP" "UP" "PSOE" "PNV"
[7] "Cs" "CIU" "ERC" "BNG" "VOX" "MP"
# manera 2
#Primero tenemos que filtrar el dataset abbrev ya que hay partidos que aceptan múltiples siglas
abbrev_sinrepes <-
abbrev |>
group_by(denominacion) |>
slice(1)
# Ahora juntamos el dataset election_data con abbrev_sinrepes para darle a cada partido su correspondiente abreviatura
resumen_2 <-
election_data |>
left_join(abbrev_sinrepes,
by = c('partidos' = 'denominacion'))
resumen_2 <-
resumen_2 |>
mutate(siglas = case_when(
str_detect(siglas, regex("ARALAR|^EA$|AMAIUR|EH Bildu", ignore_case = TRUE)) ~ 'EH-BILDU',
str_detect(siglas, regex("EB-B|ENTESA|PODEMOS|EZKERRA|UP-UPeC|I\\.U\\.", ignore_case = TRUE)) ~ 'UP',
str_detect(siglas, regex("^PP$|P\\.P-E\\.U\\.|PP-PAR|PP-FORO|PP-UPM", ignore_case = TRUE)) ~ 'PP',
str_detect(siglas, regex("PNV", ignore_case = TRUE)) ~ 'PNV',
str_detect(siglas, regex("PSOE|PSC|PSPC|PSE", ignore_case = TRUE)) ~ 'PSOE',
str_detect(siglas, regex("PAÍS|MÉS COMPROM", ignore_case = TRUE)) ~ 'MP',
str_detect(siglas, regex("VOX", ignore_case = TRUE)) ~ 'VOX',
str_detect(siglas, regex("C's", ignore_case = TRUE)) ~ 'Cs',
str_detect(siglas, regex("CiU|CDC|unio.cat", ignore_case = TRUE)) ~ 'CIU',
str_detect(siglas, regex("ERC", ignore_case = TRUE)) ~ 'ERC',
str_detect(siglas, regex("BNG|NÓS", ignore_case = TRUE)) ~ 'BNG',
# Partidos que no aparecen en abbrev que tenemos que incluir'
str_detect(partidos, regex("PARTIT POPULAR|PARTIDO POPULAR|\\(PP\\)", ignore_case = TRUE)) ~ 'PP',
str_detect(partidos, regex("CIUTADANS|PARTIDO DE LA CIU", ignore_case = TRUE)) ~ 'Cs',
str_detect(partidos, regex("CONVERGÈNCIA I", ignore_case = TRUE)) ~ 'CIU',
str_detect(partidos, regex("IZQUIERDA UNIDA|EZKER ANITZA|ESQUERRA UNIDA|^IU$|PODEMOS|AHAL DUGU|ESQUERDA UNIDA-OS VERDES", ignore_case = TRUE)) ~ 'UP',
str_detect(partidos, regex("PSOE|SOCIALISTA OBRER ESPANYOL|DOS SOCIALISTAS", ignore_case = TRUE)) ~ 'PSOE',
str_detect(partidos, regex("(EH Bildu)|PARTIDO POLITICO ARALAR|EUSKO", ignore_case = TRUE)) ~ 'EH-BILDU',
str_detect(partidos, regex("ESQUERRA REPUBLICANA/CATALUNYA SÍ|ESQUERRA REPUBLICANA$", ignore_case = TRUE)) ~ 'ERC',
TRUE ~ 'OTROS'))
unique(resumen_2$siglas) [1] "OTROS" "EH-BILDU" "PP" "UP" "PSOE" "PNV"
[7] "Cs" "CIU" "ERC" "BNG" "VOX" "MP"
Comprobamos si los resultados obtenidos de las 2 maneras son similares:
resumen_agg <- resumen |>
group_by(siglas,fecha) |>
summarise(total_votos_resumen = sum(votos, na.rm = TRUE),.groups = "drop")
resumen_2_agg <- resumen_2 |>
group_by(siglas,fecha) |>
summarise(total_votos_resumen_2 = sum(votos, na.rm = TRUE),.groups = "drop")
#filtramos por aquellos donde hay diferencias
resumen_total<-resumen_agg |>
inner_join(resumen_2_agg,by=c("siglas","fecha")) |>
mutate(dif=total_votos_resumen-total_votos_resumen_2) |>
filter(dif!=0) |>
arrange(desc(dif))
resumen_total# A tibble: 12 × 5
siglas fecha total_votos_resumen total_votos_resumen_2 dif
<chr> <date> <dbl> <dbl> <dbl>
1 UP 2019-04-01 3904519 3136096 768423
2 UP 2019-11-01 3272195 2550852 721343
3 CIU 2015-12-01 630805 65063 565742
4 UP 2016-06-01 4707199 4202593 504606
5 UP 2015-12-01 5629623 5148266 481357
6 UP 2011-11-01 1798887 1660649 138238
7 OTROS 2011-11-01 2200959 2339197 -138238
8 MP 2019-11-01 370222 545238 -175016
9 OTROS 2016-06-01 1026499 1531105 -504606
10 OTROS 2019-11-01 1524511 2070838 -546327
11 OTROS 2019-04-01 1558310 2326733 -768423
12 OTROS 2015-12-01 1243212 2290311 -1047099
Hemos descubierto que las diferencias principales están en en CIU y UP en 2015. Resumen le da 630.000 votos a CIU, pero resumen2 solo 65.000, según la web del ministerio del interior obtuvieron 567.000 (ver fichero Elecciones.xls en el repositorio de Github).
En cuanto a los votos en 2015 para UP, si se suman los de Podemos, Coalición “En Comú Podem” (En Comú), Coalición “Unidad Popular” y Coalición “Compromís - Podemos - És el Moment”, el ministerio de interior dice que obtuvieron 5.700.000 votos, muy cercano al cálculo de resumen, mientras que resumen2 se queda 500.00 votos corto.
Y parecido ocurre con la agrupación para 2016 para UP: resumen 4.700.000 vs resumen2 4.200.000 vs ministerio 5.000.000.
Por tanto creemos que la agrupación resumen es más precisa y usaremos esa agrupación para el resto del trabajo.
Vamos a hacerlo con una función para que acumule en orden de votos los gráficos según la fecha porque hemos encontrado muchos problemas para que reordenara correctamente haciéndolo de manera agregada.
colores = c("PP"="#1A4CA0",
"UP"="#9B6DC2",
"PSOE"="#D50000",
"PNV"="#018B3F",
"Cs"="#EB6109",
"ERC"="#FFCD00",
"CIU"="#1E3A5F",
"MP"="#0fddc4",
"VOX"="#1D7A2A",
"BNG"="#68abde",
"EH-BILDU"="#4C9A2A",
"OTROS"="pink",
"NA"="gray")
# Ordenamos los datos por año y votos descendentes
resumen_agg <- resumen_agg |>
arrange(fecha, desc(total_votos_resumen))
# Calculamos el porcentaje de votos para cada partido en cada año
resumen_agg_pct <- resumen_agg |>
group_by(fecha) |>
mutate(
total_votos_fecha = sum(total_votos_resumen),
porcentaje_votos = (total_votos_resumen / total_votos_fecha) * 100
) |>
ungroup()# Función para generar gráficos individuales por fecha
generar_graficos <- function(datos, colores) {
# Creamos una lista vacía para almacenar los gráficos
lista_graficos <- list()
# Obtenermos y ordenamoslas fechas únicas
fechas_unicas <- sort(unique(datos$fecha))
# Iteramos sobre cada fecha
for (fecha_actual in fechas_unicas) {
# Filtramos los datos para la fecha actual
datos_filtrados <- datos |>
filter(fecha == fecha_actual) |>
arrange(porcentaje_votos) |>
mutate(siglas = factor(siglas, levels = siglas)) # Reordenamos factores solo para esta fecha
# Cambiamos la fecha al formato año/mes (mes en letras abreviadas)
fecha_formateada <- format(as.Date(fecha_actual), "%b %Y")
# Generamos un gráfico para cada fecha
grafico <- ggplot(datos_filtrados, aes(x = "", y = porcentaje_votos, fill = siglas)) +
geom_col(position = "stack", width = 5) + # Barra apilada única
geom_text(
# Etiquetas con porcentaje solo si es mayor que 2 para que se vea bien
aes(label = ifelse(porcentaje_votos >= 2, paste0(round(porcentaje_votos, 0), "%"), "")),
position = position_stack(vjust = 0.5), # Centramos el texto dentro de las barras
color = "white", # Texto en color blanco
size = 2.75,
fontface = "bold"
) +
coord_flip() +
scale_fill_manual(values = colores, name = "Partido") +
labs(
x = NULL,
y = NULL,
title = fecha_formateada
) +
theme_minimal(base_size = 11) +
theme(
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
plot.title = element_text(size = 8, face = "italic"),
legend.position = "none"
)
# Agregamos el gráfico a la lista
lista_graficos[[as.character(fecha_actual)]] <- grafico
}
# Hacemos el orden de partidos para la leyenda global
orden_leyenda <- c("PSOE", "PP", "UP","Cs","VOX", "ERC", "PNV", "CIU", "BNG", "EH-BILDU", "MP", "OTROS")
leyenda <- ggplot(resumen_agg_pct, aes(x = siglas, y = 1, fill = siglas)) +
geom_bar(stat = "identity", width = 0) + # Asignamos valores vacíos a `y`
scale_fill_manual(values = colores, breaks=orden_leyenda,name = "") +
theme_void() +
theme(
legend.position = "bottom",
legend.text = element_text(size = 6),
legend.key.width = unit(0.5, "cm"),
legend.direction = "horizontal",
legend.box.spacing = unit(0.5, "cm"),
legend.justification = "center"
) +
guides(fill = guide_legend(nrow = 1))
# Combinamos los gráficos en una única columna
grafico_combinado <- wrap_plots(lista_graficos, ncol = 1) +
plot_annotation(
title = "Porcentaje de votos por partido en cada elección",
theme = theme(plot.title = element_text(hjust = 0.5, size = 14))
)
# Añadimos la leyenda al diseño final usando patchwork
final_plot <- grafico_combinado + leyenda
return(final_plot)
}
# Llamamos a la función con los datos y colores
grafico_final <- generar_graficos(resumen_agg_pct, colores)
print(grafico_final)Vamos a visualizar ahora los datos de otra manera, con un gráfico interactivo de líneas:
resumen_agg_pct <- resumen_agg_pct |>
mutate(
fecha_formateada = factor(format(as.Date(fecha), "%b %Y"), levels = format(sort(unique(as.Date(fecha))), "%b %Y"))
)
grafico <- ggplot(resumen_agg_pct, aes(x = fecha_formateada, y = porcentaje_votos, color = siglas, group = siglas)) +
geom_line(size = 1) +
geom_point(size = 2) +
scale_color_manual(values = colores, name = "") +
labs(
title = "Resultados en porcentaje de cada partido en cada elección",
x = NULL,
y = NULL
) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank()
)
ggplotly(grafico)¿Qué partido fue el ganador en los municipios con más de 100.000 habitantes (censo) en cada una de las elecciones?
# quitar los guiones que separan el cod_mun para poder unirlo después en base a id_municipio
cod_mun <- cod_mun |>
mutate(cod_mun = str_replace_all(cod_mun, "-", ""))
ganadores <-
resumen |>
filter(censo > 100000) |>
group_by(fecha, id_municipio) |>
arrange(desc(votos)) |>
slice(1) |>
summarise(partido_ganador = siglas,
max_votos = votos,
censo_municipio = censo) |>
ungroup() |>
left_join(cod_mun, by = c("id_municipio" = "cod_mun"))####Añadimos gráfico de España con municipios de más de 100k habitantes coloreados por los partidos que ganaron las elecciones en cada uno de los años electorales
ganadores_LAU <- ganadores |>
mutate(id_municipio = substr(id_municipio, 3, 7))
mapa_mas100k_ganadores <- mapSpain::esp_get_munic() |>
left_join(ganadores_LAU, by = c("LAU_CODE" = "id_municipio"))
ggplot(mapa_mas100k_ganadores) +
geom_sf(aes(fill = partido_ganador), alpha = 0.7, color = "grey") +
scale_fill_manual(
values = colores) +
theme_minimal() +
labs(
fill = "partido_ganador",
title = "Partidos ganadores en municipios de más de cien mil habitantes"
) +
theme(
plot.title = element_text(hjust = 0.5),
legend.position = "bottom"
) +
facet_wrap(~ fecha)¿Qué partido fue el segundo cuando el primero fue el PSOE? ¿Y cuando el primero fue el PP?
segundos <-
resumen |>
group_by(fecha, siglas) |>
summarise(total_votos = sum(votos), .groups = "drop") |>
group_by(fecha) |>
slice_max(total_votos, n = 5) |>
arrange(fecha, desc(total_votos)) |>
ungroup()
segundos# A tibble: 30 × 3
fecha siglas total_votos
<date> <chr> <dbl>
1 2008-03-01 PSOE 11071649
2 2008-03-01 PP 10171828
3 2008-03-01 OTROS 1160323
4 2008-03-01 UP 962930
5 2008-03-01 CIU 774425
6 2011-11-01 PP 10838951
7 2011-11-01 PSOE 6975407
8 2011-11-01 OTROS 2200959
9 2011-11-01 UP 1798887
10 2011-11-01 CIU 1014277
# ℹ 20 more rows
# manera 1
primeros_segundos <-
segundos |>
group_by(fecha) |>
mutate(rank = row_number()) |> # Clasificar partidos por votos en cada año
filter(rank <= 2) |> # Filtrar los dos partidos principales de cada año
summarise(
primero = siglas[rank == 1], # partido en primer lugar
votos_1 = total_votos[rank == 1], # Número de votos del primer lugar
segundo = siglas[rank == 2], # partido en segundo lugar
votos_2 = total_votos[rank == 2] # Número de votos del segundo lugar
) |>
ungroup()
primeros_segundos# A tibble: 6 × 5
fecha primero votos_1 segundo votos_2
<date> <chr> <dbl> <chr> <dbl>
1 2008-03-01 PSOE 11071649 PP 10171828
2 2011-11-01 PP 10838951 PSOE 6975407
3 2015-12-01 PP 7114123 UP 5629623
4 2016-06-01 PP 7800328 PSOE 5424130
5 2019-04-01 PSOE 7481667 PP 4356714
6 2019-11-01 PSOE 6752314 PP 5021622
# Filtrar cuando el primer lugar es PSOE
segundo_cuando_psoe <-
primeros_segundos |>
filter(primero == "PSOE")
segundo_cuando_psoe# A tibble: 3 × 5
fecha primero votos_1 segundo votos_2
<date> <chr> <dbl> <chr> <dbl>
1 2008-03-01 PSOE 11071649 PP 10171828
2 2019-04-01 PSOE 7481667 PP 4356714
3 2019-11-01 PSOE 6752314 PP 5021622
# Filtrar cuando el primer lugar es PP
segundo_cuando_pp <-
primeros_segundos |>
filter(primero == "PP")
segundo_cuando_pp# A tibble: 3 × 5
fecha primero votos_1 segundo votos_2
<date> <chr> <dbl> <chr> <dbl>
1 2011-11-01 PP 10838951 PSOE 6975407
2 2015-12-01 PP 7114123 UP 5629623
3 2016-06-01 PP 7800328 PSOE 5424130
# manera 2
# Reordenar los niveles de 'siglas' en base a 'total_votos' (de mayor a menor)
segundos <- segundos |>
group_by(fecha) |>
mutate(siglas = fct_reorder(siglas, total_votos, .desc = TRUE)) |>
ungroup()
print(levels(segundos$siglas))[1] "PSOE" "PP" "OTROS" "UP" "CIU" "Cs" "VOX"
ggplot(segundos,
aes(x = siglas,
y = total_votos,
fill = siglas)) +
geom_col(alpha = 0.8,
width = 0.7) +
scale_fill_manual(values = colores) +
labs(title = "Los cinco partidos principales en votos por año",
subtitle = "Elecciones después de 2008",
x = "Año y partido",
y = "Número de votos",
fill = "Partido") +
theme_minimal(base_family = "Rockwell") +
theme(axis.text.x = element_text(angle = 90),
axis.title.x = element_blank(),
legend.position = "bottom") +
facet_wrap(~fecha, nrow = 1, scales = "free_x")¿A quién beneficia la baja participación?
# Calcular la participación por municipio
participacion <-
resumen |>
group_by(id_municipio, siglas) |>
summarise(total_votos = sum(votos, na.rm = TRUE), .groups = "drop") |>
left_join(resumen |>
group_by(id_municipio) |>
summarise(participacion_total = sum(votos, na.rm = TRUE), .groups = "drop"),
by = "id_municipio") |>
mutate(participacion_relativa = total_votos / participacion_total)
# Calcular la correlación entre participación total y votos relativos
correlacion <- participacion |>
group_by(siglas) |>
summarise(correlacion = cor(participacion_total, participacion_relativa, use = "complete.obs"))
#Complete.obs se ocupa de los valores NA, no se si hace falta pero por si acaso lo dejo puesto
#Deberían salir nº entre -1 y 1, si está por encima de 0 la correlación es positiva lo que significa que saldría beneficiado si la participación es alta, y al revés con los resultados negativos
#Un coeficiente de correlación POSITIVO significa que, a medida que AUMENTA la participación, la proporción de votos de ese partido tiende a AUMENTAR
#Correlación positiva → Beneficio con alta participación.
#Correlación negativa → Beneficio con baja participación.
#Estamos haciendo la correlación entre estas dos cosas
#Participación total: el total de votos emitidos en un municipio
#Proporción de votos de un partido (participacion relativa): los votos de un partido como fracción de los votos totales.
# Visualización de resultados con un gráfico de barras
ggplot(correlacion, aes(x = reorder(siglas, correlacion), y = correlacion)) +
geom_col(fill = "green") +
labs(
title = "Correlación entre participación y votos por partido",
x = "Partido",
y = "Correlación"
) #poner una leyenda con la explicación de cor positiva y negativa y lo que significan con relacion a los datos y el enunciado¿Cómo analizar la relación entre censo y voto? ¿Es cierto que determinados partidos ganan en las zonas rurales?
# Para analizar la relación entre censo y voto, al ser 2 variables continuas podemos hacerlo mediante una correlación
resumen |>
summarise(correlacion = cor(censo, votos, use = "complete.obs", method = "pearson"))# A tibble: 1 × 1
correlacion
<dbl>
1 0.478
# Paara ver si hay partidos que se favorecen en las zonas rurales habría que sacar 2 tablas de datos con partidos ganadores: Una que tuviera los partidos ganadores en zonas rurales (censo < 10000), y otra que tuviera los partidos ganadores en zonas urbanas (censo > 10000)
# Partidos ganadores en zonas rurales
resumen |>
filter(censo < 10000) |>
group_by(year(fecha), id_municipio) |>
arrange(desc(votos)) |>
slice(1) |>
summarise(partido_ganador = siglas,
max_votos = votos,
censo_municipio = censo) |>
ungroup() |>
count(partido_ganador)# A tibble: 11 × 2
partido_ganador n
<chr> <int>
1 BNG 7
2 CIU 1906
3 Cs 86
4 EH-BILDU 574
5 ERC 1413
6 OTROS 719
7 PNV 592
8 PP 21492
9 PSOE 9974
10 UP 791
11 VOX 164
# Partidos ganadores en zonas no rurales
resumen |>
filter(censo > 10000) |>
group_by(year(fecha), id_municipio) |>
arrange(desc(votos)) |>
slice(1) |>
summarise(partido_ganador = siglas,
max_votos = votos,
censo_municipio = censo) |>
ungroup() |>
count(partido_ganador)# A tibble: 10 × 2
partido_ganador n
<chr> <int>
1 CIU 69
2 Cs 11
3 EH-BILDU 18
4 ERC 83
5 OTROS 30
6 PNV 67
7 PP 1397
8 PSOE 958
9 UP 228
10 VOX 30
¿Cómo calibrar el error de las encuestas (recordemos que las encuestas son de intención de voto a nivel nacional)?
# Datos de ejemplo
data <- data.frame(
partido = rep(c("PP", "PSOE", "Vox", "Sumar", "AR", "Pod.", "SAF", "Junts", "CEUS"), each = 10),
porcentaje = c(
rnorm(10, 34.6, 1), # PP
rnorm(10, 30.1, 1), # PSOE
rnorm(10, 10.1, 0.5), # Vox
rnorm(10, 6.3, 0.3), # Sumar
rnorm(10, 4.4, 0.2), # AR
rnorm(10, 3.3, 0.2), # Pod.
rnorm(10, 2.5, 0.2), # SAF
rnorm(10, 2.4, 0.1), # Junts
rnorm(10, 1.6, 0.1) # CEUS
)
)
# Calcular el promedio por partido
promedios <- data |>
group_by(partido) |>
summarise(promedio = mean(porcentaje))
# Crear el gráfico ggplot
gg <- ggplot(data, aes(x = partido, y = porcentaje)) +
geom_bar(data = promedios, aes(x = partido, y = promedio, fill = partido),
stat = "identity", alpha = 0.8, show.legend = FALSE) +
geom_jitter(width = 0.2, size = 2, alpha = 0.7, aes(text = sprintf("Encuesta: %.2f", porcentaje))) + # Puntos individuales
geom_text(data = promedios, aes(x = partido, y = promedio + 1, label = round(promedio, 1)),
size = 4, fontface = "bold", color = "black") + # Etiquetas del promedio
labs(
title = "Estimación de votos",
subtitle = "Cada punto es una encuesta y las columnas son el promedio",
x = "",
y = "Porcentaje"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 16, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.text.x = element_text(size = 10, angle = 45, hjust = 1)
)
# Convertir a gráfico interactivo con plotly
ggplotly(gg, tooltip = "text")¿Qué casas encuestadoras acertaron más y cuáles se desviaron más de los resultados?
Sugerencia: Añadir un gráfico interactivo como este donde los puntos son las previsiones de las casas encuestadoreas y las barras los resultados reales
#dar el mismo formato de resumen a surveys
surveys_2 <- surveys |>
pivot_longer(cols = "UCD":"EV", names_to = "partidos", values_to = "porcentaje", values_drop_na = TRUE )
# agrupar los partidos
surveys_3 <-
surveys_2 |>
mutate(partidos = case_when(
str_detect(partidos, "UP|IU|PODEMOS|COMPROMIS") ~ "UP",
str_detect(partidos, "PP") ~ "PP",
str_detect(partidos, "PNV") ~ "PNV",
str_detect(partidos, "PSOE") ~ "PSOE",
str_detect(partidos, "MP") ~ "MP",
str_detect(partidos, "VOX") ~ "VOX",
str_detect(partidos, "EH-BILDU|AMAIUR") ~ "EH-BILDU",
str_detect(partidos, "ERC") ~ "ERC",
str_detect(partidos, "BNG") ~ "BNG",
str_detect(partidos, "CS") ~ "Cs",
str_detect(partidos, "CIU|CDC") ~ "CIU",
TRUE ~ "OTROS"
))
#sumar los porcentajes para que no aparezcan datos repetidos
surveys_4 <- surveys_3 |>
group_by(date_elec, id_pollster, field_date_from, field_date_to, partidos) |>
mutate(porcentaje = sum(porcentaje, na.rm = TRUE)) |>
distinct()
# suma de los votos a nivel nacional por eleccion y partido, se convierte este dato en porcentaje para poder compararlo con los datos de surveys
resultados <- resumen |>
group_by(fecha, siglas) |>
summarise(Votos_Totales = sum(votos), .groups = "drop") |>
group_by(fecha) |>
mutate(Porcentaje_real = Votos_Totales / sum(Votos_Totales) * 100) |>
select(fecha, siglas, Porcentaje_real)
casas_encuestadoras <- surveys_4 |>
select(-c(id_pollster, media, field_date_from, field_date_to, exit_poll, turnout)) |>
group_by(date_elec, pollster, partidos) |>
summarise(porcentaje_estimado = mean(porcentaje, na.rm = TRUE), .groups = "drop")
#el valor que aparece en cada pollster para cada eleccion y partido es la media ya que alexandra y yo hemos pensado que para compararlo con los resultados reales lo más conveniente es tener un único dato por casa y elección, ya que se ha hecho más de una estimación en varias ocasiones
comparacion <- resultados |>
inner_join(casas_encuestadoras, by = c("siglas" = "partidos")) |> #hay que unirlo por eleccion tambien pero no se como porque el dia no coincide
mutate(Diferencia = Porcentaje_real - porcentaje_estimado)
#ahora hemos pensado que tenemos que hacer un inner join o un left join dependiendo de lo que queramos que se quede en las tablas. No nos decidimos por cual y ademas tendriamos que tener lo de las siglas y las fechas todas en un mismo formato para poder unirlas bien. ¿que creeis que hacer?
# # Paso 4: Comparar resultados reales con encuestas
# comparacion <- resultados_nacionales %>%
# left_join(encuestas_agregadas, by = "Partido") %>%
# mutate(Diferencia = Encuestas - Real)
#
# # Mostrar la tabla de comparación
# print(comparacion)Se suele decir que la población de Zaragoza es una muestra representativa de la población española (por tasas medias de renta, nivel de desigualdad, estructura poblacional o franjas de edad). ¿Son los resultados electorales en Zaragoza extrapolables a la población nacional, excluyendo los votos regionalistas o independentistas? ¿Podríamos inferir los resultados nacionales a partir de una única elección local? ¿Se comporta la población local a la hora de votar igual que la nacional?
#guardamos el id_municipio de la ciudad
muni<-"Zaragoza"
cod_mun_ciu<-cod_mun |>
filter(municipio==muni) |>
mutate(cod_mun = str_remove_all(cod_mun, "-"))
#calculamos el agregado por fecha y partido en porcentaje
resumen_ciu_pct<-resumen |>
filter(id_municipio==cod_mun_ciu$cod_mun) |>
group_by(siglas,fecha) |>
summarise(total_votos = sum(votos, na.rm = TRUE),.groups = "drop") |>
group_by(fecha) |>
mutate(total_votos_fecha = sum(total_votos),
porcentaje_votos = (total_votos / total_votos_fecha) * 100) |>
ungroup() |>
arrange(fecha,desc(porcentaje_votos))
#comparamos con los resultados nacionales
tabla_comp <- resumen_ciu_pct |>
inner_join(resumen_agg_pct, by = c("fecha", "siglas")) |>
select(fecha, siglas, porcentaje_votos.x, porcentaje_votos.y) |>
rename(pct_voto_local = porcentaje_votos.x,
pct_voto_nacional = porcentaje_votos.y)
#al haber algunos partidos a nivel nacional que no se presentan en el municipio por ser propios de otras regiones, los porcentajes nacionales no suman 100. Vamos a repartir el porcentaje nacional faltante entre todos los partidos que sí están representados de manera ponderada para q sumen 100 y poder comparar más correctamente.
tabla_ajustada <- tabla_comp |>
group_by(fecha) |>
mutate(
suma_nacional = sum(pct_voto_nacional),
faltante = 100 - suma_nacional, # Porcentaje faltante
proporcion = pct_voto_nacional / suma_nacional, # Proporción de cada partido
ajuste = proporcion * faltante, # Ajuste proporcional
pct_voto_nacional_ajustado = pct_voto_nacional + ajuste # Nuevo porcentaje ajustado
) |>
mutate(dif=pct_voto_local-pct_voto_nacional_ajustado) |>
ungroup() |>
select(fecha, siglas, pct_voto_local, pct_voto_nacional_ajustado, dif)
print(tabla_ajustada)# A tibble: 33 × 5
fecha siglas pct_voto_local pct_voto_nacional_ajustado dif
<date> <chr> <dbl> <dbl> <dbl>
1 2008-03-01 PSOE 46.6 47.3 -0.668
2 2008-03-01 PP 37.3 43.4 -6.10
3 2008-03-01 OTROS 12.6 4.96 7.64
4 2008-03-01 UP 3.26 4.11 -0.851
5 2008-03-01 Cs 0.172 0.195 -0.0228
6 2011-11-01 PP 46.8 49.7 -2.92
7 2011-11-01 PSOE 29.9 32.0 -2.05
8 2011-11-01 UP 12.9 8.25 4.68
9 2011-11-01 OTROS 10.4 10.1 0.294
10 2015-12-01 PP 29.3 30.8 -1.48
# ℹ 23 more rows
# # Gráfico de las diferencias
# tabla_ajustada <- tabla_ajustada |>
# mutate(
# siglas = factor(siglas, levels = orden_leyenda),
# fecha_formateada = factor(format(fecha, "%b %Y"), levels = format(sort(unique(fecha)), "%b %Y"))
# ) |>
# arrange(fecha_formateada)
#
# titulo<-glue("Diferencia entre Porcentajes de Votos ({muni} - Nacional)")
# ggplot(tabla_ajustada, aes(x = factor(fecha_formateada), y = dif, fill = siglas)) +
# geom_bar(stat = "identity", position = "dodge") + # Barras lado a lado
# labs(
# title = "Diferencia de porcentaje entre elecciones locales y nacionales",
# x = "",
# y = "",
# fill = ""
# ) +
# scale_fill_manual(values = colores) + # Colores personalizados
# theme_minimal() +
# theme(
# axis.text.x = element_text(angle = 45, hjust = 1), # Rotar etiquetas del eje X
# strip.text = element_text(size = 10), # Tamaño de los títulos en los paneles
# panel.spacing = unit(1, "lines") # Espaciado entre paneles
# )
#-----------------------------------------------
# tabla_ajustada <- tabla_ajustada |>
# mutate(
# siglas = factor(siglas, levels = orden_leyenda),
# fecha_formateada = factor(format(fecha, "%b %Y"), levels = format(sort(unique(fecha)), "%b %Y"))
# ) |>
# arrange(fecha_formateada)
titulo<-glue("Diferencia entre Porcentajes de Votos ({muni} - Nacional)")
# ggplot(tabla_ajustada, aes(x = fecha_formateada, y = dif, fill = siglas)) +
# geom_bar(stat = "identity", position = "dodge")
#
#
# ggplotly()El gráfico de diferencias nos da una idea general de cómo se comportan las 2 distribuciones. Aparentemente las diferencias pueden ser muy significativas, entre un 4% y un 8% de votos, que pueden significar muchos escaños, por lo que en principio no parece tener sentido hacer esa extrapolación.